(* various functions for collision handling *)
(* ---------------------------------------- *)

open Chipmunk.Low_level

(* `do nothing' collision dummy *)
let genRetFun ret arbiter space ge = ret 

(* collision handler for non-colliding objects *)
let chNoCollision ge = (
   genRetFun false, genRetFun false, genRetFun (), genRetFun (), ge)

(* ====== PLAYER - PLAYER ====== *)
(* get params and call specified function *)
let genPlayerPlayerFun getPlayers ret func arbiter space ge = 
	let idA = cpBodyGetData (cpShapeGetBody (cpArbiterGetPA arbiter)) 
   and idB = cpBodyGetData (cpShapeGetBody (cpArbiterGetPB arbiter)) 
   and players = getPlayers ge in
	let playerA = Types.IdMap.find idA players
   and playerB = Types.IdMap.find idB players in
   func ge playerA; func ge playerB; ret

(* build collision handler *)
let chPlayerPlayer getPlayers ge = (
	genPlayerPlayerFun getPlayers true Player.collisionBegin, genRetFun true, 
   genRetFun (), genPlayerPlayerFun getPlayers true Player.collisionSeparate, ge)


(* ====== TRIGGER - PLAYER ====== *)
(* get params and call specified function *)
let genTriggerCmdFun getObjects callCmd ret arbiter space ge =
   let triggerId = cpBodyGetData (cpShapeGetBody (cpArbiterGetPB arbiter))
   and objectMap = getObjects ge in
   let triggerParams = Object.getParams (Types.IdMap.find triggerId objectMap) in
   callCmd ge triggerParams; ret
let genTriggerPlayerFun getPlayers getObjects trFun ret arbiter space ge =
   let playerId = cpBodyGetData (cpShapeGetBody (cpArbiterGetPA arbiter))
   and triggerId = cpBodyGetData (cpShapeGetBody (cpArbiterGetPB arbiter))
   and playerMap = getPlayers ge
   and objectMap = getObjects ge in
   let triggeredPlayer = Types.IdMap.find playerId playerMap
   and triggerParams = Object.getParams (Types.IdMap.find triggerId objectMap) in
   trFun triggeredPlayer triggerParams; ret

(* collision handlers for each trigger type *)
(* p o c -- GameEngine's functions for getting players, objects, calling function *)
let chTriggerPlayer p o c trType ge = match trType with
   | 100  -> (genTriggerPlayerFun p o Player.makeCyan true, genTriggerPlayerFun p o Player.makeBlue false,
   (*debug*)  genTriggerPlayerFun p o Player.makeCyan (), genTriggerPlayerFun p o Player.makeGreen (), ge) 
   | 101  -> (genRetFun true, genTriggerPlayerFun p o Player.jump false, 
   (*jumper*) genRetFun (), genRetFun (), ge)
   | 102  -> (genTriggerPlayerFun p o Player.makeBlue true, genTriggerPlayerFun p o Player.makeCyan true,
   (*solid*)  genTriggerPlayerFun p o Player.makeBlue (), genTriggerPlayerFun p o Player.makeGreen (), ge) 
   | 103  -> (genRetFun true, genTriggerPlayerFun p o Player.triggerDamage false,
   (*damage*) genRetFun (), genRetFun (), ge)
   | 104  -> (genTriggerPlayerFun p o Player.triggerDamage false, genRetFun false, 
   (*trap*)   genRetFun (), genRetFun (), ge)
   | 105  -> (genTriggerCmdFun o c false, genRetFun false, 
   (*cmd*)    genRetFun (), genRetFun (), ge) 
   | _ -> assert false

(* ====== BULLET - PLAYER ====== *)
(* collision handler for bullets *)
(* actual hit processing *)
let genBulletHitFun getPlayers getObjects ret arbiter space ge =
   let (ownedShape,bulletShape) =
      if (cpCircleShapeGetRadius (cpCircleShape_of_cpShape (cpArbiterGetPA arbiter)))
         =(Config.cellSize /. 2.0) 
      then (cpArbiterGetPA arbiter, cpArbiterGetPB arbiter)
      else (cpArbiterGetPB arbiter, cpArbiterGetPA arbiter)
   in
   let objectMap = getObjects ge 
   and playerMap = getPlayers ge in
   let ownedID = cpBodyGetData (cpShapeGetBody ownedShape)
   and bulletID = cpBodyGetData (cpShapeGetBody bulletShape) in
   let bullet = Types.IdMap.find bulletID objectMap in
   match bullet with Object.Bullet (_, bulletType, ownerID) ->
      let owned = Types.IdMap.find ownedID playerMap
      and owner = (if ownerID<0 then None 
                   else Some (Types.IdMap.find ownerID playerMap)) in
      let () = Object.Bullet.hit bulletType owned owner in
      ret
      | _ -> assert false
(* deleting bullet after processed hit *)
let genBulletDelFun delObject ret arbiter space ge =
   let bulletShape =
      if (cpCircleShapeGetRadius (cpCircleShape_of_cpShape (cpArbiterGetPA arbiter)))
         =(Config.cellSize /. 2.0) 
      then cpArbiterGetPB arbiter else cpArbiterGetPA arbiter
   in
   delObject bulletShape ge; ret
(* deleting bullet after processed hit *)
let genBulletWallDelFun delObject ret arbiter space ge =
   let bulletShape =
      if (cpShapeGetType (cpArbiterGetPA arbiter) = CP_CIRCLE_SHAPE)
      then cpArbiterGetPA arbiter else cpArbiterGetPB arbiter
   in
   delObject bulletShape ge; ret

(* handler function set *)
let chBulletPlayer getPlayers getObjects delObject ge = (
   genBulletHitFun getPlayers getObjects true, genRetFun true, 
   genBulletDelFun delObject (), genRetFun (), ge)

let chBulletWall delObject ge = (
   genRetFun true, genRetFun true, 
   genBulletWallDelFun delObject (), genRetFun (), ge)
   

(* ====== PLAYER - WALL ====== *)
(* reset player's canJump attribute *)
let genPlayerWallFun getPlayers ret arbiter space ge =
   let playerShape = (if cpShapeGetCollisionType (cpArbiterGetPA arbiter) = 1
      then cpArbiterGetPA arbiter else cpArbiterGetPB arbiter) in
   let playerID = cpBodyGetData (cpShapeGetBody playerShape)
   and playerMap = getPlayers ge in
   let playerObj = Types.IdMap.find playerID playerMap in
   playerObj.Player.canJump <- !Config.jumpLength; ret

let chPlayerWall getPlayers ge = (
   genPlayerWallFun getPlayers true, genRetFun true,
   genRetFun (), genRetFun (), ge)
